home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.10 Oct 87 / region sources / Pascal Routines next >
Encoding:
Text File  |  1987-08-10  |  4.2 KB  |  188 lines  |  [TEXT/TPAS]
  1. {Some Pascal Routines for dealing with regions}
  2. {Copyright 1987 by Stephen Dubin, V.M.D., Ph.D.}
  3. {Drexel University,  Philadelphia  PA 19104}
  4.  
  5.  
  6. {###############################################################################}
  7. {#                                           #}
  8. {#                Contour procedure                   #}
  9. {#                                           #}
  10. {###############################################################################}
  11.  
  12. procedure Contour;        
  13. var
  14.     p1  :   Point;
  15.     p2  :   Point;
  16.     OldTick :  Longint;
  17.     
  18. begin
  19.  
  20.   Wipe;
  21.   TotalRegion := NewRgn;
  22.   OldTick := TickCount;
  23.   Repeat
  24.     GetMouse(p1);
  25.     MoveTo(p1.h,p1.v);
  26.     p2 := p1;  
  27.   Until Button = True;
  28.   
  29.   OpenRgn;
  30.   ShowPen;
  31.   PenMode(patXor);
  32.   
  33.   Repeat
  34.     GetMouse(p2);
  35.     Repeat Until (OldTick <> TickCount);
  36.     LineTo(p2.h,p2.v);
  37.   Until Button <> True;
  38.   
  39.   Repeat Until (OldTick <> TickCount);
  40.   LineTo(p1.h,p1.v);
  41.   PenNormal;
  42.   HidePen;
  43.   CloseRgn(TotalRegion);
  44.   InvertRgn(TotalRegion);
  45.     
  46.   
  47. end;
  48.  
  49.  
  50. {###############################################################################}
  51. {#                                           #}
  52. {#                FreeBox procedure                   #}
  53. {#                                           #}
  54. {###############################################################################}
  55.  
  56. procedure FreeBox;        
  57. var
  58.     p1  :   Point;
  59.     p2  :   Point;
  60.     p3  :   Point;
  61.     OldTick :  Longint;
  62.     MyRect  :  Rect;
  63.       
  64. begin
  65.     Wipe;
  66.     TotalRegion := NewRgn;
  67.     OldTick := TickCount;
  68.     PenPat(gray);
  69.     PenMode(patXor);
  70.     
  71.     Repeat
  72.     GetMouse(p1);
  73.     p2 := p1;  
  74.     Until Button = True;
  75.     
  76.     OpenRgn;
  77.     ShowPen;
  78.     PenMode(patXor);
  79.     
  80.     Repeat
  81.     Pt2Rect(p1,p2,MyRect);
  82.     Repeat Until (OldTick <> TickCount);
  83.     FrameRect(MyRect);
  84.     
  85.         Repeat
  86.             GetMouse(p3);
  87.         Until  EqualPt(p2,p3) <> True;
  88.    
  89.    Repeat Until (OldTick <> TickCount);
  90.    FrameRect(MyRect);
  91.    p2 := p3;
  92.    
  93.    Until Button <> True;
  94.    
  95.    Pennormal;
  96.    HidePen;
  97.    PenPat(black);
  98.    FrameRect(MyRect);
  99.    CloseRgn(TotalRegion);
  100.    InvertRgn(TotalRegion);
  101.  
  102.   
  103. end;
  104.  
  105.   
  106. {###############################################################################}
  107. {#                                           #}
  108. {#                 CountPix function                   #}
  109. {#                                           #}
  110. {###############################################################################}
  111.  
  112. function CountPix(theRegion : RgnHandle): LongInt;        
  113. var
  114.  pt : Point;
  115.  rgn    :   Region;
  116.  temp   :   LongInt; 
  117.   
  118. begin
  119.    temp   :=  0;
  120.    rgn  :=  theRegion^^;
  121.    for  pt.h  := rgn.rgnBBox.left  to  rgn.rgnBBox.right do 
  122.         begin
  123.             for pt.v := rgn.rgnBBox.top to rgn.rgnBBox.bottom do
  124.                 if  PtInRgn( pt, TheRegion) then  temp := temp + 1;  
  125.         end;
  126.         CountPix := temp;
  127. end;
  128.   
  129.  
  130.  
  131.  
  132. {###############################################################################}
  133. {#                                           #}
  134. {#                 Data procedure                   #}
  135. {#                                           #}
  136. {###############################################################################}
  137.  
  138. procedure Data;        
  139. var
  140.     rgn         :   Region;
  141.     rgnpntr     :   Ptr;
  142.     size        :   Integer;
  143.     halfsize    :   Integer;
  144.     thebuf      :   BUF;
  145.     bfpntr      :   Ptr;
  146.     myString    :   Str255;
  147.     i           :   Integer;
  148.     x           :   Integer;
  149.     y           :   Integer;
  150.  
  151.  begin
  152.     Wipe;
  153.     TextSize(9);
  154.     TextFont(Monaco);
  155.     rgn  :=  totalRegion^^;
  156.     rgnpntr := ptr(totalRegion^); 
  157.     size := rgn.rgnSize;
  158.     if size > 800 then size:= 800;
  159.     bfpntr := ptr(@thebuf);
  160.     BlockMove(rgnpntr,bfpntr,size);
  161.     MoveTo(10,10);
  162.     DrawString('Here are the first 400 words of the region data. (FLAG = 32767)');
  163.     x := 10;
  164.     y := 20;
  165.     for i  := 1  to  (size div 2) do 
  166.         begin
  167.         MoveTo(x,y);
  168.         NumToString(theBuf[i],myString);
  169.         if theBuf[i] < 32766 then 
  170.             begin
  171.                 if theBuf[i] <10  then DrawString(' ');
  172.                 if theBuf[i] <100 then DrawString(' ');
  173.                 if theBuf[i] < 1000 then DrawString(' ');
  174.                 if theBuf[i] < 10000 then DrawString(' ');
  175.                 DrawString(MyString);
  176.             end;
  177.         if theBuf[i] > 32766 then DrawString(' FLAG');
  178.         x := x + 30;
  179.         if (i mod 16) = 0 then
  180.             begin
  181.             x := 10;
  182.             y := y+10;
  183.             end; 
  184.         end;
  185.     
  186. end;
  187.  
  188.